www.gusucode.com > 地方成人教育中心整站源代码 1 > 地方成人教育中心整站源代码 1.0/inc/Function.asp

    <%
'*************************************************
'函数名：gotTopic
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'       strlen ----截取长度
'返回值：截取后的字符串
'*************************************************
function gotTopic(str,strlen)
	if str="" then
		gotTopic=""
		exit function
	end if
	dim l,t,c, i
	str=replace(replace(replace(replace(str,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<")
	l=len(str)
	t=0
	for i=1 to l
		c=Abs(Asc(Mid(str,i,1)))
		if c>255 then
			t=t+2
		else
			t=t+1
		end if
		if t>=strlen then
			gotTopic=left(str,i) & "…"
			exit for
		else
			gotTopic=str
		end if
	next
	gotTopic=replace(replace(replace(replace(gotTopic," ","&nbsp;"),chr(34),"&quot;"),">","&gt;"),"<","&lt;")
end function

'***********************************************
'函数名：JoinChar
'作  用：向地址中加入 ? 或 &
'参  数：strUrl  ----网址
'返回值：加了 ? 或 & 的网址
'***********************************************
function JoinChar(strUrl)
	if strUrl="" then
		JoinChar=""
		exit function
	end if
	if InStr(strUrl,"?")<len(strUrl) then 
		if InStr(strUrl,"?")>1 then
			if InStr(strUrl,"&")<len(strUrl) then 
				JoinChar=strUrl & "&"
			else
				JoinChar=strUrl
			end if
		else
			JoinChar=strUrl & "?"
		end if
	else
		JoinChar=strUrl
	end if
end function

'**************************************************
'函数名：strLength
'作  用：求字符串长度。汉字算两个字符，英文算一个字符。
'参  数：str  ----要求长度的字符串
'返回值：字符串长度
'**************************************************
function strLength(str)
	ON ERROR RESUME NEXT
	dim WINNT_CHINESE
	WINNT_CHINESE    = (len("中国")=2)
	if WINNT_CHINESE then
        dim l,t,c
        dim i
        l=len(str)
        t=l
        for i=1 to l
        	c=asc(mid(str,i,1))
            if c<0 then c=c+65536
            if c>255 then
                t=t+1
            end if
        next
        strLength=t
    else 
        strLength=len(str)
    end if
    if err.number<>0 then err.clear
end function

'*************************************************
'函数名：RemoveHTML
'作  用：过滤HTML代码
'参  数：strHTML   ----原字符串
'返回值：过滤后的字符串
'*************************************************

Function RemoveHTML(strHTML) 
Dim objRegExp, Match, Matches 
Set objRegExp = New Regexp 
objRegExp.IgnoreCase = True 
objRegExp.Global = True 
'取闭合的<> 
objRegExp.Pattern = "<.+?>" 
'进行匹配 
Set Matches = objRegExp.Execute(strHTML) 
' 遍历匹配集合，并替换掉匹配的项目 
For Each Match in Matches 
strHtml=Replace(strHTML,Match.Value,"") 
Next 
RemoveHTML=strHTML 
Set objRegExp = Nothing 
End Function

'*************************************************
'函数名：GetState
'作  用：获取查询条件字符串
'返回值：查询条件字符串
'*************************************************

Function GetState() 
    if idea_5=0 then
        GetState="true"
    else
        GetState="1"
    end if
End Function

'过滤xss注入
Function Checkxss(byVal ChkStr)
    Dim Str
    Str = ChkStr
    If IsNull(Str) Then
        CheckStr = ""
        Exit Function
    End If
    Str = Replace(Str, "&", "&amp;")
    Str = Replace(Str, "'", "&acute;")
    Str = Replace(Str, """", "&quot;")
        Str = Replace(Str, "<", "&lt;")
        Str = Replace(Str, ">", "&gt;")
        Str = Replace(Str, "/", "&#47;")
        Str = Replace(Str, "*", "&#42;")
    Dim re
    Set re = New RegExp
    re.IgnoreCase = True
    re.Global = True
    re.Pattern = "(w)(here)"
    Str = re.Replace(Str, "$1h&#101;re")
    re.Pattern = "(s)(elect)"
    Str = re.Replace(Str, "$1el&#101;ct")
    re.Pattern = "(i)(nsert)"
    Str = re.Replace(Str, "$1ns&#101;rt")
    re.Pattern = "(c)(reate)"
    Str = re.Replace(Str, "$1r&#101;ate")
    re.Pattern = "(d)(rop)"
    Str = re.Replace(Str, "$1ro&#112;")
    re.Pattern = "(a)(lter)"
    Str = re.Replace(Str, "$1lt&#101;r")
    re.Pattern = "(d)(elete)"
    Str = re.Replace(Str, "$1el&#101;te")
    re.Pattern = "(u)(pdate)"
    Str = re.Replace(Str, "$1p&#100;ate")
    re.Pattern = "(\s)(or)"
    Str = re.Replace(Str, "$1o&#114;")
        re.Pattern = "(\n)"
    Str = re.Replace(Str, "$1o&#114;")
        '----------------------------------
        re.Pattern = "(java)(script)"
    Str = re.Replace(Str, "$1scri&#112;t")
        re.Pattern = "(j)(script)"
    Str = re.Replace(Str, "$1scri&#112;t")
        re.Pattern = "(vb)(script)"
    Str = re.Replace(Str, "$1scri&#112;t")
        '----------------------------------
        If Instr(Str, "expression") > 0 Then
                Str = Replace(Str, "expression", "e&#173;xpression", 1, -1, 0)
        End If
    Set re = Nothing
    Checkxss = Str
End Function
%>